home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d10
/
chrpro3.arc
/
MCONSTAT.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1991-01-21
|
7KB
|
268 lines
* Program MCONSTAT - Prints a one-period contributions report (indiv statement)
Select secondary
USE CDIRFILE index CDIRFILE
Store curdates to curdatex
GOTO 10
Store !($(spact,26,1)) to offsform
SKIP
Store !($(spact,21,1)) to offpledg
Store '0' to N
If OFFNOTE
GOTO 27
Store 'x' to offnote9
Do while # < 47
Store $(spact,2,39) to OFFNOTE9
SKIP
Store OFFNOTE9+$(spact,2,39) to OFFNOTE&N
Store str(val(N)+1,1) to N
SKIP
enddo
If N='*'
Store '9' to N
endif
Do while OFFNOTE&N = ;
' '
Store str(val(N)-1,1) to N
enddo
endif
Store str(val(N)+1,1) to NN
Select primary
Store '-' to NMFL
Select secondary
Store d+':MEMBERS' to MFILE
Store d+':OFFERNDX.NDX' to NFILE
If .not. file(MFILE)
? 'MEMBERS.DBF file not present on the data disk. It must be copied over'
Accept 'from the MPROFILE program system/disk. Press <RETURN>' to XX
USE CDIRFILE index CDIRFILE
Select primary
RETURN
endif
If .not. file(NFILE)
? 'Offering index file OFFERNDX, now being created against MEMBERS file.'
Use &MFILE
Set talk on
Index on offeringen to &NFILE
Set talk off
endif
USE &MFILE index &NFILE
? 'This routine prints a report. Ready the printer.'
Accept 'Print statements for all members? ' to XX
If !(XX) = 'Y'
Store offermax to maxrec
Accept 'Enter starting envelope number, or press <retn> for beginning ' to XX
If !(XX)=' '
Store 1 to recnum
Find 1
If #=0
Store 2 to recnum
Find 2
If #=0
Store 3 to recnum
Find 3
If #=0
Accept 'No envelope number less than 3 in MEMBERS file. Press <retn> ' to XX
RETURN
endif
endif
endif
else
Store val(XX) to recnum
endif
else
Accept 'Enter a single envelope number needing a statement ' to XX
IF !(XX)='Q'
Use
Select primary
RETURN
ENDIF
IF !(XX)=' '
STORE 1 TO RECNUM
ELSE
Store val(XX) to recnum
ENDIF
Store recnum+1 to maxrec
endif
Store str(recnum,4) to rec
Release XX,continu,valid2,osel,mfile,nfile,validd1,level1,goodhdr
Release pageprnt,offermax,prnt,msel,nmonth
Select primary
GOTO &rec
STORE 0 TO NONM
Set format to print
Do while RECNUM<MAXREC .and. .not. EOF
Select secondary
Find &rec
If (last:name)=' ' .or. #=0
If val(OCATEG&OT)<>0
? 'No name for envelope number',rec
Store NONM+1 to NONM
If NONM > 50
Set format to screen
? 'Too many envelope numbers without corresponding names in MEMBERS file:',NMFL
Accept 'Press <retn> to terminate ' to PRNT
RETURN
else
Store trim(NMFL)+str(recnum,4)+'-' to NMFL
endif
Store 1 to PRNT
endif
else
Store trim(first:name) to tfname
Store trim(last:name) to namet
Store address to addresst
Store trim(city:state)+' '+trim(zip) to cityst
* If husband and wife, print both their names, husband first
SKIP
If offeringen=recnum
If $(familycode,8,1)='2'
Store tfname+' and '+trim(first:name) to tfname
else
Store trim(first:name)+' and '+tfname to tfname
endif
else
SKIP -1
endif
Store tfname+' '+namet to namet
Select primary
* Print one Contribution Statement
Store '0' to N
Do while N<>OT
STORE STR(VAL(N)+1,1) TO N
Store 0.00 to GIVING
Store 1 to wknum
Do while WKNUM < WKNUMMAX
Store $(OCATEG&N,WKNUM*8+2,8) to GIVING1
Store &GIVING1 + GIVING TO GIVING
Store wknum+1 to WKNUM
enddo
Store GIVING to OCATEGT&N
Store $(OCATEG&N,1,9) to GIVING1
Store &GIVING1+GIVING to OCATEGY&N
enddo
Release GIVING,GIVING1
Set format to print
If offsform<>'Y'
@ 2,25 say CHNAME
@ 6,20 say ' C O N T R I B U T I O N R E C O R D'
endif
@ 12,12 SAY NAMET
@ 12,50 SAY curdate
@ 13,12 SAY ADDRESST
@ 14,12 SAY CITYST
IF OFFSFORM<>'Y'
@ 14,50 SAY 'ENVELOPE'
ENDIF
@ 14,60 SAY STR(OFFERINGEN,4)
@ 22,25 SAY 'Report of Contributions through '+CMONTHCO
Store '0' to N
Store 20 to CN
If offsform<>'Y'
@ 26,16 say HDR3
endif
Store 28 to LN
Store 10 to WKNO
Store 1 to week
STORE 1 to wknum
Do while wknum < wknummax
@ LN,12 say $(curdatex,week,5)
Store '0' to N
Store 21 to CN
Do while N<>OT
Store str(val(N)+1,1) to N
Store $(OCATEG&N,WKNO,8) to resp
If resp<>' '
@ LN,CN say '$'+resp
endif
If CSA<>' '.and. N='4'
@ LN,67 say $(SPACCOUNTS,wknum+1,1)
endif
Store CN+12 to CN
enddo
Store LN+1 to LN
Store WKNO+8 to WKNO
Store wknum+1 to wknum
Store week+6 to week
enddo
Store LN+2 to LN
If OFFSFORM<>'Y'
@ LN,0 say 'Totals for '+cmonthco
endif
Store 20 to CN
Store '0' to N
Do while N<>OT
Store str(val(N)+1,1) to N
Store str(ocategt&N,9,2) to XX
@ LN,CN say '$'+XX
Store CN+12 to CN
enddo
Store LN+1 to LN
Store 20 to CN
If OFFSFORM<>'Y'
@ LN,0 say 'YEAR-TO-DATE'
endif
Store '0' to N
Do while N<>OT
Store str(val(N)+1,1) to N
Store str(OCATEGY&N,9,2) to XX
@ LN,CN say '$'+XX
Store CN+12 to CN
enddo
If offpledg='Y'
Store LN+2 to LN
@ LN,30 say 'Pledged for the year: $'+pledged
endif
Store LN+2 to LN
Store LN+12 to CN
Store '0' to N
Do while N<>NN
@ LN,1 say OFFNOTE&N
Store LN+1 to LN
Store str(val(N)+1,1) to N
enddo
endif
EJECT
* End of one statement
Store recnum+1 to recnum
Store str(recnum,4) to rec
Select primary
SKIP
enddo
If recnum<maxrec
? 'CONTRIB file has less than the user-defined maximum envelope number.'
? 'Statement printing is terminated.'
endif
Set format to screen
If NONM>0
ERASE
@ 2,2 say 'THE FOLLOWING ENVELOPE NUMBERS HAVE NO NAMES IN THE'
@ 3,2 SAY "MEMBERS FILE. NO STATEMENTS WERE PRINTED FOR THEM:"
? ' '
? NMFL
ENDIF
?
If OFFNOTE
Release OFFNOTE0,OFFNOTE1,OFFNOTE2,OFFNOTE3,OFFNOTE4,OFFNOTE5,OFFNOTE6,;
OFFNOTE7,OFFNOTE8,OFFNOTE9
endif
ACCEPT 'End of Contributions Statements. Press <retn> to exit.' to XX
RETURN
Store 10 to WKNO
Store 1 to week
STORE 1 to wknum
Do while wknum < wknummax
@ LN,12 say $(curdatex,week,5)
Store '0' to N
Store 21 to CN
Do while N<>OT
Store str(val(N)+1,1) to N
Store $(OCATEG&N,WKNO,8) to resp
If resp<>' '
@ LN,CN say '$'+resp
endif
If CSA<>' '.and.N=4
@ LN,67 say $(SPACCOUNT,wknum+1,1)
endif